home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1987 / 09 / shamm.sep < prev    next >
Text File  |  1987-08-13  |  17KB  |  685 lines
  1. byte
  2.  
  3. Ch
  4.  
  5.  
  6. integer
  7.  
  8. Count
  9. Diff
  10. Flag[7001]
  11. I
  12. Iter
  13. K
  14. Prime
  15. T1
  16. T2
  17.  
  18.  
  19. constants
  20.  
  21. SIZE = 7001
  22.  
  23.  
  24. main
  25.  
  26. read clock (T1)
  27. for (Iter,1,1,1)  ** Main loop **
  28.     assign (0,Count)
  29.     for (I,1,SIZE,1)  ** Init. flags **
  30.         assign (1,Flag[I])
  31.     for (I,1,SIZE,1)
  32.         if (Flag[I] = 1)
  33.             assign (I+I+3,Prime)
  34.             assign (I + Prime,K)
  35.             while (K  SIZE)
  36.                 assign (0,Flag[K])
  37.                 assign (K+Prime,K)
  38.             assign (Count+1,Count)
  39.         else 
  40.             
  41. read clock (T2)
  42. wait (5000)
  43. assign ((T2-T1)/60,Diff)
  44. write output (1,"@i",Diff)
  45. get key (100,Ch)
  46.  
  47.  
  48. Example 1: V.I.P. text output for the first version of the sieve program
  49.  
  50.  
  51.  
  52.  
  53.  
  54. byte
  55.  
  56. Ch
  57.  
  58.  
  59. integer
  60.  
  61. Count
  62. Diff
  63. Flag[7001]
  64. Iter
  65. T1
  66. T2
  67.  
  68.  
  69. main
  70.  
  71. read clock (T1)
  72. for (Iter,1,1,1)
  73.     init  ** Initialize flags **
  74.     body (Count)  ** Body of sieve **
  75. read clock (T2)
  76. assign (T2 - T1,Diff)
  77. write output (1,"@i",Diff)
  78. get key (5000,Ch)
  79.  
  80.  
  81. body (Count)
  82.  
  83.  
  84. <-- integer Count
  85.  
  86.  
  87. integer
  88.  
  89. Flags[7001]
  90. I
  91. K
  92. Prime
  93.  
  94.  
  95. assign (0,Count)
  96. for (I,1,7001,1)
  97.     if (Flag[I] = 1)
  98.         assign (I+I+3,Prime)
  99.         assign (I+Prime,K)
  100.         while (K  7001)
  101.             assign (0,Flag[K])
  102.             assign (K+Prime,K)
  103.         assign (Count+1,Count)
  104.     else 
  105.         
  106.  
  107. init
  108.  
  109. integer
  110.  
  111. I
  112.  
  113.  
  114. for (I,1,7001,1)
  115.     assign (1,Flag[I])
  116.  
  117.  
  118. Example 2: V.I.P. text output for the modified sieve program
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127. PROGRAM  CBTree;
  128.  
  129. {======================================================
  130.   Program to test the compare the time needed in creating and
  131.    searching a binary tree and a CB-tree.
  132.   Author: Namir Clement Shammas
  133. ======================================================}
  134.  
  135. CONST SIZE = 1000;
  136.       RANGE = 10000;
  137.       MainLoopCount = 100;
  138.  
  139. TYPE Bin_Ptr =  ^Bin_Node;
  140.  
  141.      { normal binary tree strcutures }
  142.      Bin_Node = RECORD
  143.               Value : INTEGER;
  144.               Left, Right : Bin_Ptr;
  145.             END;
  146.  
  147.      CB_Ptr =  ^CB_Node;
  148.  
  149.      { Record structure for clustured binary tree }
  150.      CB_Node = RECORD
  151.               Value : INTEGER;
  152.               HLeft, HRight,
  153.               LLeft, LRight : CB_Ptr;
  154.             END;
  155.  
  156.      REGTYPE = RECORD
  157.                  AX,BX,CX,DX,BP,
  158.                  DI,SI,DS,ED,FLAGS  : INTEGER
  159.                END;
  160.  
  161.      Time_Rec = RECORD
  162.                  HOUR, MIN, SEC, HSEC : BYTE
  163.               END;
  164.  
  165.  
  166. VAR Numbers : ARRAY [1..SIZE] OF INTEGER;
  167.     Iter, I, Choice, CDV, Diff : INTEGER;
  168.     BinTreeRoot : Bin_Ptr;
  169.     CBTreeRoot : CB_Ptr;
  170.     Timer_Start, Timer_Stop, Time_Elapsed : Time_Rec;
  171.  
  172. {-----------------------------------------------------}
  173.  
  174. PROCEDURE Get_Time(VAR TIME : Time_Rec { output });
  175.  
  176. VAR REGISTER : REGTYPE;
  177.     AH       : BYTE;
  178.  
  179. BEGIN
  180.  
  181.   AH  :=  $2C;
  182.  
  183.      WITH REGISTER, TIME DO BEGIN
  184.         AX:= AH SHL 8;
  185.         MSDOS(REGISTER);
  186.         HOUR :=  Hi(CX);
  187.         MIN  :=  Lo(CX);
  188.         SEC  :=  Hi(DX);
  189.         HSEC :=  Lo(DX);
  190.       END;
  191. END;
  192.  
  193. {---------------------------------------------------------}
  194.  
  195. PROCEDURE Time_Diff(T_Start, 
  196.                     T_Finish       : Time_Rec;  { input  }
  197.                     VAR Delta_Time : Time_Rec   { output });
  198.  
  199. BEGIN
  200.  
  201.  WITH Delta_Time DO BEGIN
  202.  
  203.     HOUR := T_Finish.HOUR - T_Start.HOUR;
  204.  
  205.     IF T_Start.MIN > T_Finish.MIN THEN BEGIN
  206.         HOUR := HOUR - 1; 
  207.         T_Finish.MIN := T_Finish.MIN + 60;
  208.     END;
  209.     MIN := T_Finish.MIN - T_Start.MIN;
  210.  
  211.     IF T_Start.SEC > T_Finish.SEC THEN BEGIN
  212.         MIN := MIN - 1;
  213.         T_Finish.SEC := T_Finish.SEC + 60;
  214.     END;
  215.     SEC := T_Finish.SEC - T_Start.SEC;
  216.  
  217.     IF T_Start.HSEC > T_Finish.HSEC THEN BEGIN
  218.         SEC := SEC - 1;
  219.         T_Finish.HSEC := T_Finish.HSEC + 100;
  220.     END;
  221.     HSEC := T_Finish.HSEC - T_Start.HSEC;
  222.  
  223.  END; (* WITH *)
  224.  
  225. END; (* Time_Diff *)
  226.  
  227. {---------------------------------------------------------}
  228.  
  229. PROCEDURE Show_Time(T : Time_Rec { input });
  230.  
  231. BEGIN
  232.     WITH T DO BEGIN
  233.         WRITE('Time elapsed = ',HOUR,' : ',MIN,' : ',SEC,'.',HSEC);
  234.     END;
  235. END; (* Show_Time *)
  236.  
  237. {---------------------------------------------------------}
  238.  
  239. PROCEDURE Create(Choice : INTEGER { input });
  240.  
  241. VAR J : INTEGER;
  242.     Angle, FloatSize, Increment : REAL;
  243.  
  244. BEGIN
  245.     CASE Choice OF
  246.      1 : BEGIN
  247.             Angle := 0.0;
  248.             Increment := Pi / 360.0;
  249.             FOR J := 1 TO SIZE DO BEGIN
  250.                 Numbers[J] := Trunc(SIN(Angle) * RANGE);
  251.                 Angle := Angle + Increment;
  252.             END;
  253.         END;
  254.      2 : BEGIN
  255.             Angle := 0.0;
  256.             Increment := Pi / 360.0;
  257.             FOR J := 1 TO SIZE DO BEGIN
  258.                 Numbers[J] := Trunc(COS(Angle) * RANGE);
  259.                 Angle := Angle + Increment;
  260.             END;
  261.         END;
  262.  
  263.      ELSE BEGIN
  264.             Numbers[1] := RANGE div 2;
  265.             FOR J := 2 TO SIZE DO
  266.                 Numbers[J] := Trunc(Random * RANGE);
  267.          END;
  268.    END; { CASE }
  269. END;
  270.  
  271. {---------------------------------------------------------}
  272.  
  273. PROCEDURE Bin_Insert(VAR Root : Bin_Ptr; { input }
  274.                          Item : INTEGER  { input });
  275. (* Insert element in binary-tree *)
  276. BEGIN
  277.     IF Root = NIL THEN BEGIN
  278.         NEW(Root);
  279.         Root^.Value := Item;
  280.         Root^.Left := NIL;
  281.         Root^.Right := NIL
  282.     END
  283.     ELSE
  284.         WITH Root^ DO
  285.             IF Item < Value THEN Bin_Insert(Left,Item)
  286.                             ELSE Bin_Insert(Right,Item);
  287. END;
  288.  
  289. {---------------------------------------------------------}
  290.  
  291. PROCEDURE Bin_Search(VAR Root : Bin_Ptr; { input }
  292.                        Target : INTEGER  { input });
  293. (* Recursive procedure to search for Target value *)
  294. BEGIN
  295.     IF Root <> NIL THEN
  296.         IF Target <> Root^.Value THEN
  297.             IF Target < Root^.Value THEN BEGIN
  298.                 Root := Root^.Left;
  299.                 Bin_Search(Root,Target)
  300.             END
  301.             ELSE BEGIN
  302.                 Root := Root^.Right;
  303.                 Bin_Search(Root,Target)
  304.             END;
  305. END;
  306.  
  307. {---------------------------------------------------------}
  308.  
  309. PROCEDURE CB_Insert(VAR Root : CB_Ptr; { input } 
  310.                     VAR Item : INTEGER { input });
  311. (* Insert element in a CB-tree *)
  312.  
  313.  
  314. BEGIN
  315.     IF Root = NIL THEN BEGIN
  316.         NEW(Root);
  317.         Root^.Value  := Item;
  318.         Root^.LLeft  := NIL;
  319.         Root^.LRight := NIL;
  320.         Root^.HLeft  := NIL;
  321.         Root^.HRight := NIL;
  322.     END
  323.     ELSE
  324.         WITH Root^ DO BEGIN
  325.             Diff := Value - Item;
  326.             IF Diff > 0 THEN
  327.                 IF ABS(Diff) <= CDV THEN CB_Insert(LLeft,Item)
  328.                                     ELSE CB_Insert(HLeft,Item)
  329.             ELSE
  330.                 IF ABS(Diff) <= CDV THEN CB_Insert(LRight,Item)
  331.                                     ELSE CB_Insert(HRight,Item);
  332.         END; (* WITH *)
  333. END;
  334.  
  335. {---------------------------------------------------------}
  336.  
  337. PROCEDURE CB_Search(VAR Root   : CB_Ptr; { input }
  338.                     VAR Target : INTEGER { input });
  339. (* Recursive procedure to search for Target value *)
  340.  
  341.  
  342. BEGIN
  343.     IF Root <> NIL THEN
  344.         IF Target <> Root^.Value THEN BEGIN
  345.             Diff := Root^.Value - Target;
  346.             IF Target < Root^.Value THEN BEGIN
  347.                 IF ABS(Diff) <= CDV THEN Root := Root^.LLeft
  348.                                     ELSE Root := Root^.HLeft;
  349.                 CB_Search(Root,Target)
  350.             END
  351.             ELSE BEGIN
  352.                 IF ABS(Diff) <= CDV THEN Root := Root^.LRight
  353.                                     ELSE Root := Root^.HRight;
  354.                 CB_Search(Root,Target)
  355.             END;
  356.         END;
  357. END;
  358.  
  359. {---------------------------------------------------------}
  360.  
  361. BEGIN (* MAIN *)
  362.     CDV := Trunc(0.05 * RANGE);
  363.  
  364.     ClrScr;
  365.     WRITE(' ':10);
  366.     WRITELN('--------- Menu for Method of Generating Numbers --------');
  367.     WRITELN;
  368.     WRITELN(' 0) Random numbers ');
  369.     WRITELN(' 1) Sine function ');
  370.     WRITELN(' 2) Cosine function ');
  371.     WRITELN;
  372.     WRITE('Enter code for array creation : ');
  373.     READLN(Choice); WRITELN;
  374.     Create(Choice);
  375.  
  376.     WRITELN; WRITELN('Created array'); WRITELN;
  377.     (* Building the binary tree *)
  378.     BinTreeRoot := NIL;
  379.     Get_Time(Timer_Start);
  380.     FOR I := 1 TO SIZE DO
  381.        Bin_Insert(BinTreeRoot,Numbers[I]);
  382.     Get_Time(Timer_Stop);
  383.     Time_Diff(Timer_Start, Timer_Stop, Time_Elapsed);
  384.     Show_Time(Time_Elapsed);
  385.     WRITELN(' for creating binary Tree'); WRITELN;
  386.  
  387.     (* Building the CB-tree *)
  388.     CBTreeRoot := NIL;
  389.     Get_Time(Timer_Start);
  390.     FOR I := 1 TO SIZE DO
  391.        CB_Insert(CBTreeRoot,Numbers[I]);
  392.     Get_Time(Timer_Stop);
  393.     Time_Diff(Timer_Start, Timer_Stop, Time_Elapsed);
  394.     Show_Time(Time_Elapsed);
  395.     WRITELN(' for creating CB-Tree'); WRITELN;
  396.  
  397.     Get_Time(Timer_Start);
  398.     FOR Iter := 1 TO MainLoopCount DO
  399.         FOR I := SIZE DOWNTO 1 DO
  400.             Bin_Search(BinTreeRoot,Numbers[SIZE + 1 - I]);
  401.     Get_Time(Timer_Stop);
  402.     Time_Diff(Timer_Start, Timer_Stop, Time_Elapsed);
  403.     Show_Time(Time_Elapsed); WRITELN(' for binary tree search');
  404.     WRITELN;
  405.  
  406.     Get_Time(Timer_Start);
  407.     FOR Iter := 1 TO MainLoopCount DO
  408.            FOR I := SIZE DOWNTO 1 DO
  409.             CB_Search(CBTreeRoot,Numbers[SIZE + 1 - I]);
  410.     Get_Time(Timer_Stop);
  411.     Time_Diff(Timer_Start, Timer_Stop, Time_Elapsed);
  412.     Show_Time(Time_Elapsed); WRITELN(' for CB-tree search');
  413.     WRITELN;
  414.     WRITELN('DONE'); WRITELN;
  415. END.
  416.  
  417.  
  418. Listing 1: Turbo Pascal program that compares the speed of building and searching binary and CB trees
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426. PROGRAM Test_Clustered_Lists;
  427.  
  428. {$R+,V-}
  429.  
  430. {============================================================
  431.  
  432.   Turbo Pascal program that implements routine for inserting,
  433.   searching and viewing clustered list structures.
  434.  
  435.   Copyright (c) 1987  Namir Clement Shammas
  436.  
  437. ============================================================}
  438.  
  439. CONST LENSTRING = 30;
  440.       MAX_LIST = 100;
  441. «MDNM»
  442.       CDV = 0; { Critical Difference value }
  443.  
  444. TYPE LSTRING = STRING[LENSTRING];
  445.      KeyArray = ARRAY [1..MAX_LIST] OF LSTRING;
  446.  
  447.      ListPtr = ^ListNode;
  448.  
  449.      { CLustered List structure }
  450.      ListNode = RECORD
  451.                   Key : LSTRING;
  452.                   { other fields may be placed here }
  453.                   NextPtr, NextHi : ListPtr;
  454.                 END;
  455.  
  456. VAR Head : ListPtr;
  457.     LesKeys : KeyArray;
  458.     I, Count : INTEGER;
  459.  
  460. {---------------------------------------------------------}
  461.  
  462. PROCEDURE Search_Node(Head        : ListPtr; { input }
  463.                       SearchData  : LSTRING; { input }
  464.                   VAR Found       : BOOLEAN; { output }
  465.                   VAR LastPtr,
  466.                       ThisPtr     : ListPtr  { output });
  467.  
  468. { search for 'SearchData' in list }
  469.  
  470. VAR HiTrack : BOOLEAN;
  471.     Ord1, Diff : INTEGER;
  472.  
  473. BEGIN
  474.     Found := FALSE;
  475.     HiTrack := TRUE;
  476.     LastPtr := NIL;
  477.     ThisPtr := Head;
  478.  
  479.     Ord1 := ORD(SearchData[1]);
  480.  
  481.     WHILE (ThisPtr <> NIL) AND (ThisPtr^.Key < SearchData) DO BEGIN
  482.  
  483.         LastPtr := ThisPtr;
  484.  
  485.         IF HiTrack THEN BEGIN
  486.  
  487.             Diff := ORD(ThisPtr^.Key[1]) - Ord1;
  488.  
  489.             IF ABS(Diff) > CDV
  490.             THEN
  491.                 ThisPtr := ThisPtr^.NextHi
  492.             ELSE BEGIN
  493.                 ThisPtr := ThisPtr^.NextPtr;
  494.                 HiTrack := FALSE { switch to low track }
  495.             END; { IF ABS(Diff) }
  496.        END
  497.  
  498.        ELSE
  499.            ThisPtr := ThisPtr^.NextPtr;
  500.        { END IF HiTrack }
  501.  
  502.     END; { WHILE }
  503.  
  504.     IF ThisPtr <> NIL THEN Found := (ThisPtr^.Key = SearchData);
  505.  
  506. END; { Search_Node }
  507.  
  508. {---------------------------------------------------------}
  509.  
  510. PROCEDURE Insert_List(VAR Head : ListPtr; { in/out }
  511.                        NewData : LSTRING  { input  });
  512. { Insert new data string into the list }
  513.  
  514. VAR Found : BOOLEAN;
  515.     Ord1, Diff : INTEGER;
  516.     Tempo : LSTRING;
  517.     Node, LastPtr, ThisPtr : ListPtr;
  518.  
  519. BEGIN
  520.  
  521.     Ord1 := ORD(NewData[1]); { get ascii code of firt char }
  522.  
  523.     IF Head = NIL THEN BEGIN { start a new list }
  524.         new(Head);
  525.         WITH Head^ DO BEGIN
  526.             NextPtr := NIL;
  527.             NextHi  := NIL;
  528.             Key := NewData
  529.         END; { WITH }
  530.     END
  531.  
  532.     ELSE BEGIN { expand list }
  533.         new(Node);
  534.         WITH Node^ DO BEGIN
  535.             Key := NewData;
  536.             NextPtr := NIL;
  537.             NextHi := NIL
  538.         END; { WITH }
  539.  
  540.         Search_Node(Head, Node^.Key, Found, LastPtr, ThisPtr);
  541.  
  542.         IF LastPtr = NIL THEN BEGIN { insert as new list head }
  543.             Diff := ORD(Head^.Key[1]) - Ord1;
  544.             IF ABS(DIFF) > CDV THEN
  545.                 Node^.NextHi := Head
  546.             ELSE
  547.                 Node^.NextHi  := Head^.NextHi;
  548.                 Node^.NextPtr := Head;
  549.             { END IF }
  550.  
  551.             Head := Node;
  552.         END
  553.  
  554.         ELSE BEGIN { insert new data in the middle or at the tail }
  555.  
  556.             Diff := Ord1 - ORD(LastPtr^.Key[1]);
  557.  
  558.             IF Diff <= CDV THEN BEGIN
  559.                 { insert inside a clustered sublist }
  560.                 { LasPtr may be a high of low track node }
  561.                 Node^.NextPtr := LastPtr^.NextPtr;
  562.                 LastPtr^.NextPtr := Node
  563.             END
  564.  
  565.             ELSE BEGIN
  566.  
  567.                 IF ThisPtr <> NIL
  568.                 THEN BEGIN
  569.                     Diff := Ord1 - ORD(ThisPtr^.Key[1]);
  570.                     IF ABS(Diff) > CDV
  571.                     THEN BEGIN {insert between two high track nodes }
  572.                         Node^.NextHi := LastPtr^.NextHi;
  573.                         LastPtr^.NextHi := Node
  574.                     END
  575.                     ELSE BEGIN {swap names in the next high track node }
  576.                         Tempo := Node^.Key;
  577.                         Node^.Key := ThisPtr^.Key;
  578.                         ThisPtr^.Key := Tempo;
  579.                         { insert a new swapped first element }
  580.                         { in clustered sublist               }
  581.                         Node^.NextPtr := ThisPtr^.NextPtr;
  582.                         ThisPtr^.NextPtr := Node
  583.                     END; { IF }
  584.  
  585.                 END
  586.                 ELSE BEGIN { insert as last high track node }
  587.                     Node^.NextHi := LastPtr^.NextHi;
  588.                     LastPtr^.NextHi := Node
  589.                 END; { IF }
  590.             END; { IF }
  591.         END; { IF LastPtr = NIL }
  592.  
  593.     END; { IF Head = NIL }
  594.  
  595. END; { Insert_List }
  596.  
  597. {---------------------------------------------------------}
  598.  
  599. PROCEDURE List_to_Array(Head      : ListPtr;  { input  }
  600.                         VAR Keys  : KeyArray; { output }
  601.                         VAR Count : INTEGER   { output });
  602.  
  603. { Converts the list to an array containing sorted names }
  604.  
  605. {---------------------------------------------------------}
  606.  
  607. PROCEDURE Visit_Low_Node(VAR Node : ListPtr);
  608. { Local recursive routine to visit low tracks of a list }
  609.  
  610. BEGIN
  611.  
  612.     IF (Node <> NIL) AND (Count < MAX_LIST) THEN BEGIN
  613.         Count := Count + 1;
  614.         Keys[Count] := Node^.Key;
  615.         WRITE(' ',Keys[Count]:10);
  616.         Visit_Low_Node(Node^.NextPtr);
  617.     END
  618.     ELSE WRITELN(' -]');
  619.  
  620. END; { Visit_Low_Node }
  621.  
  622. {---------------------------------------------------------}
  623.  
  624. PROCEDURE Visit_Hi_Node(VAR Node : ListPtr);
  625. { Local recursive routine to visit high tracks of a list }
  626.  
  627. BEGIN
  628.  
  629.     IF (Node <> NIL) AND (Count < MAX_LIST) THEN BEGIN
  630.         Count := Count + 1;
  631.         Keys[Count] := Node^.Key;
  632.         WRITE(Keys[Count]:10);
  633.         Visit_Low_Node(Node^.NextPtr);
  634.         Visit_Hi_Node(Node^.NextHi);
  635.     END;
  636.  
  637. END; { Visit_Hi_Node }
  638.  
  639. {---------------------------------------------------------}
  640.  
  641. BEGIN
  642.  
  643.  
  644.     IF Head <> NIL THEN BEGIN
  645.         Count := 0;
  646.         Visit_Hi_Node(Head);
  647.  
  648.     END
  649.  
  650.     ELSE
  651.         Count := 0;
  652.     { END IF }
  653.  
  654.  
  655. END; { List_to_Array }
  656.  
  657. {---------------------------------------------------------}
  658.  
  659. BEGIN
  660.  
  661.     ClrScr;
  662.     IF CDV < 0 THEN BEGIN
  663.         WRITELN('Adjust Critical Difference Value Please');
  664.         HALT
  665.     END;
  666.  
  667.     Head := NIL;
  668.     WRITELN('List of sorted capitals '); WRITELN;
  669.     Insert_List(Head,'Athens');     Insert_List(Head,'London');
  670.     Insert_List(Head,'Bonn');       Insert_List(Head,'Ankara');
  671.     Insert_List(Head,'Sau Paulo');  Insert_List(Head,'Moscow');
  672.     Insert_List(Head,'Otawa');      Insert_List(Head,'Tokyo');
  673.     Insert_List(Head,'Bern');       Insert_List(Head,'Warsaw');
  674.     Insert_List(Head,'Cairo');      Insert_List(Head,'Rome');
  675.     Insert_List(Head,'Madrid');     Insert_List(Head,'Lisbon');
  676.     Insert_List(Head,'Paris');      Insert_List(Head,'Baghdad');
  677.  
  678.     List_to_Array(Head, LesKeys, Count);
  679.  
  680. END.
  681.  
  682.  
  683. Listing 2:  Turbo Pascal program to demonstrate clustered lists structured
  684.  
  685.